home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / code_gen / vbxwzrd / bmpfilm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-22  |  7.1 KB  |  224 lines
  1. {
  2.   Program: BmpFilm
  3.   Date: 20/2/1995
  4.   Purpose: To create a custom control (vbx) for Visual Basic or Delphi
  5. }
  6. Library BmpFilm;
  7. {$R BmpFilm}
  8. Uses WinTypes,WinProcs,VBApi;
  9. { Custom control data and structs }
  10. Type PBmpFilm=^TBmpFilm;
  11.      TBmpFilm=Record
  12.       About:Enum;
  13.       Picture:hPic;
  14.       Interval:Integer;
  15.       Cols:Integer;
  16.       Rows:Integer;
  17.       Col,Row:Integer;
  18.      End;
  19. Const 
  20. { Declare Property }
  21.       Property_About:TPROPINFO=(
  22.       npszName:NPnt(PChar('(About)'));
  23.       fl:DT_ENUM or PF_fGetData or PF_fSetData or PF_fSetMsg;
  24.       offsetData:Byte(0);
  25.       infoData:0;
  26.       dataDefault:0;
  27.       npszEnumList:Npnt(PChar('Click on "..." for About Box'+#0+#0));
  28.       enumMax:0);
  29.       Property_Picture:TPROPINFO=(
  30.       npszName:NPnt(PChar('Picture'));
  31.       fl:DT_PICTURE or PF_fGetData or PF_fSaveData or PF_fSetData or PF_fSetMsg;
  32.       offsetData:Byte(1);
  33.       infoData:0;
  34.       dataDefault:0;
  35.       npszEnumList:Npnt(PChar(+#0+#0));
  36.       enumMax:0);
  37.       Property_Interval:TPROPINFO=(
  38.       npszName:NPnt(PChar('Interval'));
  39.       fl:DT_SHORT or PF_fGetData or PF_fSaveData or PF_fSetData or PF_fSetMsg;
  40.       offsetData:Byte(3);
  41.       infoData:0;
  42.       dataDefault:0;
  43.       npszEnumList:Npnt(PChar(+#0+#0));
  44.       enumMax:0);
  45.       Property_Cols:TPROPINFO=(
  46.       npszName:NPnt(PChar('Cols'));
  47.       fl:DT_SHORT or PF_fGetData or PF_fSaveData or PF_fSetData or PF_fSetMsg;
  48.       offsetData:Byte(5);
  49.       infoData:0;
  50.       dataDefault:0;
  51.       npszEnumList:Npnt(PChar(+#0+#0));
  52.       enumMax:0);
  53.       Property_Rows:TPROPINFO=(
  54.       npszName:NPnt(PChar('Rows'));
  55.       fl:DT_SHORT or PF_fGetData or PF_fSaveData or PF_fSetData or PF_fSetMsg;
  56.       offsetData:Byte(7);
  57.       infoData:0;
  58.       dataDefault:0;
  59.       npszEnumList:Npnt(PChar(+#0+#0));
  60.       enumMax:0);
  61. { Declare Events }
  62.       Event_Paint:TEVENTINFO=(
  63.       npszName:NPnt(PChar('Paint'));
  64.       cParms:0;
  65.       cwParms:2*0;
  66.       npParmTypes:0;
  67.       npszParmProf:NPnt(PChar(''));
  68.       fl:0);
  69. { Property List }
  70.       PropListBmpFilm:array[0..14] of PPropInfo=(
  71.       PPropInfo_Std_CTLNAME,
  72.       PPropInfo_Std_HWND,
  73.       PPropInfo_Std_INDEX,
  74.       PPropInfo(@Property_About),
  75.       PPropInfo_Std_ENABLED,
  76.       PPropInfo_Std_HEIGHT,
  77.       PPropInfo_Std_LEFT,
  78.       PPropInfo_Std_TOP,
  79.       PPropInfo_Std_VISIBLE,
  80.       PPropInfo_Std_WIDTH,
  81.       PPropInfo(@Property_Picture),
  82.       PPropInfo(@Property_Interval),
  83.       PPropInfo(@Property_Cols),
  84.       PPropInfo(@Property_Rows),0);
  85. { Event List }
  86.       EventListBmpFilm:array[0..6] of PEventInfo=(
  87.       PEventInfo_Std_CLICK,
  88.       PEventInfo_Std_DBLCLICK,
  89.       PEventInfo_Std_MOUSEDOWN,
  90.       PEventInfo_Std_MOUSEMOVE,
  91.       PEventInfo_Std_MOUSEUP,
  92.       PEventInfo(@Event_Paint),0);
  93. { This routine handles the 'About' Dialog messages }
  94. function AboutDlgProc(Dlg:HWnd;Msg,wParam:Word;lParam:LongInt):Bool; export;
  95. begin
  96.   AboutDlgProc:=False;
  97.   case Msg of
  98.     WM_Create:AboutDlgProc:=True;
  99.     WM_InitDialog:Exit;
  100.     WM_Command:if (wParam=id_OK)or(wParam=id_Cancel) then EndDialog(Dlg,0);
  101.   end;{End of Case}
  102. end;
  103. { Constans and Variables }
  104. { Control Procedure }
  105. { This routine is called for all VB and Windows Messages }
  106. function BmpFilmCtlProc(Control:hCtl;Wnd:hWnd;Msg,wParam:Word;lParam:LongInt):LongInt; Export;
  107. const hBrOld:hBrush=0;
  108. var BmpFilm:PBmpFilm;
  109.     TP:TPaintStruct;
  110.     Pic:Tpic;
  111.     hPicture:hPic;
  112.     BMP:TBitmap;
  113.     hBR:hBrush;
  114.     MemDC:hDC;
  115. begin
  116.   BmpFilm:=PBmpFilm(VBDerefControl(Control));
  117.   case Msg of
  118.     WM_NCCREATE:
  119.     begin 
  120.       BmpFilm^.Col:=0;
  121.       BmpFilm^.Row:=0;
  122.       VBSetControlProperty(Control,11,200);
  123.       VBSetControlProperty(Control,12,3);
  124.       VBSetControlProperty(Control,13,6);
  125.     end;
  126.     WM_TIMER:
  127.     begin
  128.       if BmpFilm^.Row=BmpFilm^.Rows-1 then
  129.       begin
  130.         BmpFilm^.Row:=0;
  131.         Inc(BmpFilm^.Col);
  132.       end else Inc(BmpFilm^.Row);
  133.       if BmpFilm^.Col=BmpFilm^.Cols then
  134.       begin
  135.         BmpFilm^.Row:=0;
  136.         BmpFilm^.Col:=0;
  137.       end;
  138.       InvalidateRect(Wnd,nil,False);
  139.     end;
  140.     WM_PAINT:
  141.     begin
  142.       BeginPaint(Wnd,TP);
  143.       if VBGetMode=MODE_RUN then VBFireEvent(Control,5,nil);
  144.       VBGetControlProperty(Control,10,@hPicture);
  145.       if hPicture<>0 then
  146.         begin
  147.           VBGetPic(hPicture,@Pic);
  148.           hBR:=GetBrushOrg(TP.hDC);
  149.           if Bool(hbr) then hbrOld:=SelectObject(TP.hDC,hBR);
  150.           GetObject(Pic.PicData.Bitmap,sizeof(TBitMap),PChar(@Bmp));
  151.           MemDC:=CreateCompatibleDC(TP.hDC);
  152.           SelectObject(MemDC,Pic.PicData.Bitmap);
  153.           BitBlt(TP.hDC,0,0,Bmp.bmWidth div BmpFilm^.Rows,Bmp.bmHeight div BmpFilm^.Cols,MemDC
  154.                 ,BmpFilm^.Row*(Bmp.bmWidth div BmpFilm^.Rows),BmpFilm^.Col*(Bmp.bmHeight div BmpFilm^.Cols),SRCCOPY);
  155.           SelectObject(TP.hDC,hbrOld);
  156.           DeleteDC(MemDC);
  157.         end;
  158.       EndPaint(Wnd,TP);
  159.       Exit;
  160.     end;
  161.     VBM_SETPROPERTY:
  162.     case wParam of
  163.       10:InvalidateRect(Wnd,nil,True);
  164.       11:
  165.       begin
  166.         if VBGetMode=MODE_RUN then
  167.         begin
  168.           VBGetControlProperty(Control,11,@BmpFilm^.Interval);
  169.           SetTimer(Wnd,100,BmpFilm^.Interval,nil);
  170.         end;
  171.         InvalidateRect(Wnd,nil,True);
  172.       end;
  173.       12:
  174.       begin
  175.         VBGetControlProperty(Control,12,@BmpFilm^.Cols);
  176.         InvalidateRect(Wnd,nil,True);
  177.       end;
  178.       13:
  179.       begin
  180.         VBGetControlProperty(Control,13,@BmpFilm^.Rows);
  181.         InvalidateRect(Wnd,nil,True);
  182.       end;
  183.     end;
  184.     WM_USER:VBDialogBoxParam(hInstance,'ABOUT',@AboutDlgProc,0);WM_USER+1:VBDialogBoxParam(hInstance,'ABOUT',@AboutDlgProc,0);
  185.     VBM_INITPROPPOPUP:if wParam=3 then
  186.     begin
  187.       BmpFilmCtlProc:=LoWord(lParam+1);
  188.       PostMessage(Wnd,WM_USER,0,0);
  189.       Exit;
  190.     end;
  191.   end;    { End of case Msg }
  192.   BmpFilmCtlProc:=VBDefControlProc(Control,Wnd,Msg,wParam,lParam);
  193. end; {End of Control function}
  194. { Model struct                               }
  195. { Define the control model                   }
  196. { (using the event and property structures). }
  197. Const ModelBmpFilm:TModel=(
  198.       UsVersion:VB300_VERSION;    { VB version used by control }
  199.       Fl:0;
  200.       CtlProc:TFarProc(@BmpFilmCtlProc);
  201.       FsClassStyle:0 or cs_HRedraw or cs_VRedraw;
  202.       FlWndStyle:0;
  203.       CbCtlExtra:SizeOf(TBmpFilm);
  204.       IdBmpPalette:8000;          { Bitmap ID for tool palette }
  205.       DefCtlName:NPnt(PChar('BmpFilm'));
  206.       ClassName:NPnt(PChar('BmpFilm'));
  207.       ParentClassName:0;
  208.       PropList:Ofs(PropListBmpFilm);
  209.       EventList:Ofs(EventListBmpFilm);
  210.       NDefProp:0;                 { Index of default property }
  211.       NDefEvent:0);               { Index of default event }
  212. { Register custom control.                     }
  213. { This routine is called by VB when the custom }
  214. { control DLL is loaded for use.               }
  215. function VBInitCC(usVersion:Word;fRunTime:Boolean):Boolean; Export;
  216. begin
  217.   VBInitCC:=VBRegisterModel(hInstance,ModelBmpFilm);
  218. end;
  219. Exports
  220.   VBInitCC         index 2,
  221.   BmpFilmCtlProc index 3,
  222.   AboutDlgProc;
  223. Begin
  224. End. { End of Custom Control }